home *** CD-ROM | disk | FTP | other *** search
/ Mac Mania 2 / MacMania 2.toast / Demo's / Tools&Utilities / Programming / ViewIt 2.24 / FORTRAN Demo Projects / Absoft MacFortran II 3.2 Demos / Old MF 020 Stuff / FaceProcMF.inc < prev    next >
Encoding:
Text File  |  1993-12-01  |  3.7 KB  |  122 lines  |  [TEXT/EDIT]
  1. C FaceWare 2.2 Initialization & Dispatching Procedures
  2. C ©FaceWare 1989-93.  All Rights Reserved.
  3.  
  4.     SUBROUTINE FaceIt(xPtr,m1,m2,m3,m4,m5)
  5.     implicit none
  6.     INTEGER FRONTWINDOW,GETRESOURCE,HIDEWINDOW,OPENRESFILE,PTR
  7.     INTEGER TEINIT,INITDIALOGS,FLUSHEVENTS,EXITTOSHELL
  8.     PARAMETER (EXITTOSHELL=Z'9F400000')
  9.     PARAMETER (FLUSHEVENTS=Z'03200008')  !include file is wrong
  10.     PARAMETER (FRONTWINDOW = Z'92480000')
  11.     PARAMETER (GETRESOURCE = Z'9A091000')
  12.     PARAMETER (HIDEWINDOW = Z'91610000')
  13.     PARAMETER (OPENRESFILE = Z'99770000')
  14.     PARAMETER (PTR = Z'C0000000')
  15.     PARAMETER (TEINIT = Z'9CC00000')
  16.     PARAMETER (INITDIALOGS = Z'97B10000')
  17.     integer*2 fHead(8),uHead(8),vHead(8),xEntries
  18.     integer*4 i,xPtr,m1,m2,m3,m4,m5,thePtr,fPtr,toolbx,ftnWin
  19.     integer*4 fFlags,uCommand,uParam(4),cControl,xTable(40)
  20.     character*4 restype
  21.     character*256 uName
  22.       integer*1 fRec(2548)
  23.       common/FaceStuff/fRec
  24.       equivalence (fRec(1),fHead(1))
  25.     equivalence (fRec(39),fFlags)
  26.     equivalence (fRec(1003),uHead(1))
  27.     equivalence (fRec(1071),uCommand)
  28.     equivalence (fRec(1075),uParam(1))
  29.     equivalence (fRec(1359),uName)
  30.     equivalence (fRec(1635),vHead(1))
  31.     equivalence (fRec(1703),cControl)
  32.     equivalence (fRec(2387),xEntries)
  33.     equivalence (fRec(2389),xTable(1))
  34.     thePtr = xPtr
  35.     fPtr = toolbx(PTR,fRec)
  36.     if (m1 = -61) then
  37.       if ((m4 > -1).and.((m4.and.1) = 0)) then
  38.         call toolbx(TEINIT)          !perform Mac initializations
  39.         call toolbx(INITDIALOGS,0)
  40.         call toolbx(FLUSHEVENTS,62)  !ignore spurious mouse & key events
  41.         ftnWin = toolbx(FRONTWINDOW) !unneeded Fortran window?
  42.         if (ftnWin <> 0) call toolbx(HIDEWINDOW,ftnWin)        
  43.       end if
  44.       uName = char(len(trim(uName)))//uName
  45.       restype = 'FCMD'         !find LoadIt or quit to Finder
  46.       if (toolbx(GETRESOURCE,restype,1000) = 0) then
  47.         if (toolbx(OPENRESFILE,uName) < 0) then
  48.           call toolbx(EXITTOSHELL)
  49.         end if
  50.       end if
  51.       fFlags = m2             !store FaceIt bit flags
  52.       xEntries = m5             !store # of table entries
  53.       thePtr = fPtr
  54.       if (m3 > -1) then           !call LoadIt to expand heap?
  55.         call PrepIt(thePtr,m3,0,0,thePtr)
  56.         call JumpIt(thePtr)
  57.       end if
  58.       call PrepIt(thePtr,1100,22,0,thePtr)      !setup fRec header
  59.       call PrepIt(thePtr+1002,1210,22,0,thePtr) !setup uRec header
  60.       call PrepIt(thePtr+1634,1200,22,0,thePtr) !setup vRec header
  61.       fHead(6) = m4                !store environment type
  62.       uHead(6) = 2                 !establish string type
  63.       thePtr = 0
  64.       if (m4 < -3) return
  65.     end if
  66.     if (m1 = -62) then
  67.       call PrepIt(m2,m3,m4,m5,fPtr)
  68.     else if ((m1 < 0).and.(m1 > -11)) then
  69.       i = (4 * (-1 - m1))
  70.       xTable(1+i) = m2
  71.       xTable(2+i) = m3
  72.       xTable(3+i) = m4
  73.       xTable(4+i) = m5
  74.     else
  75.       if (thePtr = 0) then    !call to default module?
  76.         thePtr = fPtr + 1002
  77.       else if (long(thePtr + 12) <> fPtr) then
  78.         cControl = thePtr     !call to control driver?
  79.         thePtr = fPtr + 1634
  80.       end if
  81.       word(thePtr + 8) = 0
  82.       uCommand = m1           !pass Command & Params
  83.       uParam(1) = m2
  84.       uParam(2) = m3
  85.       uParam(3) = m4
  86.       uParam(4) = m5
  87.       call JumpIt(thePtr)     !jump to FCMD module
  88.     end if
  89.     end
  90.  
  91.     SUBROUTINE PrepIt(x,b,v,r,f)
  92.     implicit none
  93.     INTEGER GETRESOURCE
  94.     PARAMETER (GETRESOURCE = Z'9A091000')
  95.     integer*4 i,x,b,v,r,f,toolbx
  96.     character*4 restype    
  97.     integer*2 xEntries
  98.     integer*4 xTable(40)
  99.       integer*1 fRec(2548)
  100.       common/FaceStuff/fRec
  101.     equivalence (fRec(2387),xEntries)
  102.     equivalence (fRec(2389),xTable(1))
  103.     restype = 'FCMD'
  104.     long(x) = long(toolbx(GETRESOURCE,restype,1000))
  105.     word(x + 4) = b        !baseID
  106.     word(x + 6) = v        !versID
  107.     word(x + 8) = 0        !message
  108.     word(x + 10) = r        !resID
  109.     long(x + 12) = f        !fPtr
  110.     if (xEntries > 0) then
  111.      do (i = 0, xEntries-1)
  112.       if (b = xTable(1 + 4*i)) then
  113.        if (v = xTable(2 + 4*i)) then
  114.         if (0 <> xTable(4 + 4*i)) then
  115.          long(x) = xTable(4 + 4*i)
  116.         end if
  117.        end if
  118.       end if
  119.      repeat
  120.     end if
  121.     end
  122.